Explore

data <- read_csv("Mental_Health_copy.csv", 
                 col_types = cols(`Quartile Range` = col_skip(), 
                                  `Suppression Flag` = col_skip(),
                                  LowCI = col_skip(),
                                  HighCI= col_skip(),
                                  `Confidence Interval`= col_skip())) %>%
  mutate(t = ifelse(`Time Period`>21, `Time Period`+1,`Time Period`)) %>%
  mutate(t2 = ifelse(t==1, 22,t)) %>%
  select(-c(t,`Time Period`)) %>% rename(`Time Period`=t2)

Temporal by state and indicator

Took Prescription Medication for Mental Health, Last 4 Weeks

# taking prescription filter
data_states_13_meds <- data %>% 
  filter(Indicator == "Took Prescription Medication for Mental Health, Last 4 Weeks",
         Group == "By State" ) %>% 
  mutate(State1 = tolower(State)) %>%
  select(Value, State = State1, Indicator, t = `Time Period`, `Time Period Label`) 

MainStates <- map_data("state") %>% mutate(State = tolower(region)) 
merged_pres <- inner_join(MainStates, data_states_13_meds, by = "State")

# MainStates_lab <- MainStates %>% distinct(region,.keep_all=T)
region.lab.data <- merged_pres %>%
  group_by(region) %>% summarise(long=mean(long), lat=mean(lat))

map_took_pres <- ggplot() + 
  theme_classic() +
  geom_polygon(data=merged_pres, 
          aes(x=long, y=lat, group=group, fill = Value, frame =  t), 
          color="white", size = 0.2) +
  scale_fill_gradient(low = "lightblue", high = "darkred")  +
  geom_text(aes(label = region,x = long, y = lat), data = region.lab.data, size=1, alpha = 0.001) +
  # annotate("text", x = -120, y = 25, label = merged_pres$`Time Period Label`, frame = t) +
  labs(title="Took Prescription Medication for Mental Health, Last 4 Weeks", fill = "%")+
  theme(axis.line=element_blank(),
      axis.text.x=element_blank(),
      axis.text.y=element_blank(),
      axis.ticks=element_blank(),
      axis.title.x=element_blank(),
      axis.title.y=element_blank())

fig <- ggplotly(map_took_pres) 
fig <- fig %>% 
  animation_opts(
    0, easing = "elastic", redraw = FALSE
  ) %>%
  animation_slider(
    currentvalue = list(prefix = "Time Period ", font = list(color="red"))
  ) #%>%
  # layout(annotations = list(x = -120, y = 25, text = paste("Time Period: ",
  #   merged_pres$`Time Period Label`), showarrow = F))
  

fig$x$frames <- lapply(
  fig$x$frames, function(f) { 
    f$data <- lapply(f$data, function(d) d[!names(d) %in% c("x", "y")])
    f 
  })

fig

Received Counseling or Therapy, Last 4 Weeks

data_states_13_thrp <- data %>% 
  filter(Indicator == "Received Counseling or Therapy, Last 4 Weeks",
         Group == "By State") %>% 
  mutate(State1 = tolower(State)) %>%
  select(Value, State = State1, Indicator, t = `Time Period`, `Time Period Label`) 

# merge with state
merged_thrp <- inner_join(MainStates, data_states_13_thrp, by = "State")

map_thrp <- ggplot() + 
  theme_classic() +
  geom_polygon(data=merged_thrp, 
          aes(x=long, y=lat, group=group, fill = Value, frame =  t), 
          color="white", size = 0.2) +
  scale_fill_gradient(low = "lightblue", high = "darkred")  +
  geom_text(aes(label = region,x = long, y = lat), data = region.lab.data, size=1, alpha = 0.001) +
  labs(title="Received Counseling or Therapy, Last 4 Weeks", fill = "%")+
  theme(axis.line=element_blank(),
      axis.text.x=element_blank(),
      axis.text.y=element_blank(),
      axis.ticks=element_blank(),
      axis.title.x=element_blank(),
      axis.title.y=element_blank())

fig2 <- ggplotly(map_thrp) 
fig2 <- fig2 %>% 
  animation_opts(
    0, easing = "elastic", redraw = FALSE
  )

fig2$x$frames <- lapply(
  fig2$x$frames, function(f) { 
    f$data <- lapply(f$data, function(d) d[!names(d) %in% c("x", "y")])
    f 
  })

fig2

Took Prescription Medication for Mental Health And/Or Received Counseling or Therapy, Last 4 Weeks

data_states_13_both <- data %>% 
  filter(Indicator == "Took Prescription Medication for Mental Health And/Or Received Counseling or Therapy, Last 4 Weeks",
         Group == "By State" 
         #,`Time Period` == 13
         ) %>% 
  mutate(State1 = tolower(State)) %>%
  select(Value, State = State1, Indicator, t = `Time Period`, `Time Period Label`) 

# merge with state
merged_both <- inner_join(MainStates, data_states_13_both, by = "State")

map_both <- ggplot() + 
  theme_classic() +
  geom_polygon(data=merged_both, 
          aes(x=long, y=lat, group=group, fill = Value, frame =  t), 
          color="white", size = 0.2) +
  scale_fill_gradient(low = "lightblue", high = "darkred")  +
  # geom_text(data=MainStates_lab, aes(long, lat, label = region), size=2) +
  labs(title="Took Prescription Medication for Mental Health And/Or Received Counseling or Therapy, Last 4 Weeks", fill = "%")+
  theme(axis.line=element_blank(),
      axis.text.x=element_blank(),
      axis.text.y=element_blank(),
      axis.ticks=element_blank(),
      axis.title.x=element_blank(),
      axis.title.y=element_blank())

fig3 <- ggplotly(map_both) 
fig3 <- fig3 %>% 
  animation_opts(
    0, easing = "elastic", redraw = FALSE
  )

fig3$x$frames <- lapply(
  fig3$x$frames, function(f) { 
    f$data <- lapply(f$data, function(d) d[!names(d) %in% c("x", "y")])
    f 
  })

fig3

Needed Counseling or Therapy But Did Not Get It, Last 4 Weeks

data_states_13_need <- data %>% 
  filter(Indicator == "Needed Counseling or Therapy But Did Not Get It, Last 4 Weeks",
         Group == "By State" 
         #,`Time Period` == 13
         ) %>% 
  mutate(State1 = tolower(State)) %>%
  select(Value, State = State1, Indicator, t = `Time Period`, `Time Period Label`) 

# merge with state
merged_need <- inner_join(MainStates, data_states_13_need, by = "State")

map_need <- ggplot() + 
  theme_classic() +
  geom_polygon(data=merged_need, 
          aes(x=long, y=lat, group=group, fill = Value, frame =  t), 
          color="white", size = 0.2) +
  scale_fill_gradient(low = "lightblue", high = "darkred")  +
  # geom_text(data=MainStates_lab, aes(long, lat, label = region), size=2) +
  labs(title="Needed Counseling or Therapy But Did Not Get It, Last 4 Weeks", fill = "%")+
  theme(axis.line=element_blank(),
      axis.text.x=element_blank(),
      axis.text.y=element_blank(),
      axis.ticks=element_blank(),
      axis.title.x=element_blank(),
      axis.title.y=element_blank())

fig4 <- ggplotly(map_need) 
fig4 <- fig4 %>% 
  animation_opts(
    0, easing = "elastic", redraw = FALSE
  )

fig4$x$frames <- lapply(
  fig4$x$frames, function(f) { 
    f$data <- lapply(f$data, function(d) d[!names(d) %in% c("x", "y")])
    f 
  })

fig4

Period mismatch

data%>% 
  distinct(`Time Period`, 
           `Time Period Label`)

## # A tibble: 16 x 2
##    `Time Period Label` `Time Period`
##    <chr>                       <dbl>
##  1 Aug 19 - Aug 31                13
##  2 Sep 2 - Sep 14                 14
##  3 Sep 16 - Sep 28                15
##  4 Sep 30 - Oct 12                16
##  5 Oct 14 - Oct 26                17
##  6 Oct 28 - Nov 9                 18
##  7 Nov 11 - Nov 23                19
##  8 Nov 25 - Dec 7                 20
##  9 Dec 9 - Dec 21                 21
## 10 Dec 22 - Jan 5                 22
## 11 Jan 6 - Jan 18                 23
## 12 Jan 20 - Feb 1                 24
## 13 Feb 3 - Feb 15                 25
## 14 Feb 17 - Mar 1                 26
## 15 Mar 3 - Mar 15                 27
## 16 Mar 17 - Mar 29                28

Mar 17 - Mar 29 –> 27 Dec 22 - Jan 5 –> 1 –> between 21 and 22

period numbers mismatch

add national averages

add state label

Hover for drop down

By indicator, Drop down info: state, gender, race

data_state_pres <- data %>% 
  filter(Indicator == "Took Prescription Medication for Mental Health, Last 4 Weeks")%>%
  pivot_wider(names_from = c("Subgroup"), values_from = "Value") %>%
  distinct(.keep_all = T)
# data$hover <- with(data, paste(State, '<br>', "Female", Female, "Male", Male, "<br>",
#                                "Hispanic or Latino", `Hispanic or Latino`, "<br>",
#                                "White", `Non-Hispanic white, single race`,
#                                "Asian", `Non-Hispanic Asian, single race`,"<br>",
#                                "Black", `Non-Hispanic black, single race`, "Other/Multiple Races", 
#                                `Non-Hispanic, other races and multiple races`))
# 
# fig <- plot_geo(df, locationmode = 'USA-states')
# fig <- fig %>% add_trace(
#     z = ~total.exports, text = ~hover, locations = ~code,
#     color = ~total.exports, colors = 'Purples'
#   )
# fig <- fig %>% colorbar(title = "Millions USD")
# fig <- fig %>% layout(
#     title = '2011 US Agriculture Exports by State<br>(Hover for breakdown)'
#   )
# 
# fig